home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 126-150 / disk_143 / rim / rimsrcami.arc / HELPGEN.FFF < prev    next >
Text File  |  1988-01-05  |  2KB  |  74 lines
  1. $NOFLOATCALLS
  2. $STORAGE:4
  3.       PROGRAM HELPIN
  4.       INTEGER*4 TUPLE(28)
  5.     INTEGER*4 HENDC,HENDD
  6.     CHARACTER*4 CHENDC,CHENDD
  7.     EQUIVALENCE(HENDC,CHENDC),(HENDD,CHENDD)
  8.       REAL*8 DBNAME
  9.       REAL*8 RNAME
  10.     CHARACTER*8 CRNAME,CDBNAM
  11.     EQUIVALENCE(CRNAME,RNAME),(CDBNAM,DBNAME)
  12.     DATA CHENDC/'ENDC'/,CHENDD/'ENDD'/
  13.       CDBNAM = 'HELPDB'
  14.       CRNAME = 'HELP'
  15.     OPEN(6,FILE='CON')
  16.       CALL RMOPEN(DBNAME)
  17.       CALL RMFIND(1,RNAME)
  18.       TUPLE(2) = 8
  19.     OPEN(2,FILE='HELPTXT.DAT',STATUS='OLD')
  20.     1 CONTINUE
  21.       READ (2,10)TUPLE(1)
  22. C *** DEBUG
  23.     WRITE(6,5001)TUPLE(1)
  24. 5001    FORMAT(1X,' ** NEW TUPLE START ***** TXT=',A4)
  25. C ***
  26.    10 FORMAT(A4)
  27.       READ (2,20)(TUPLE(I),I=3,7)
  28.    20 FORMAT(5A4)
  29.    50 CONTINUE
  30.       TUPLE(9) = 0
  31.       CALL GETL(TUPLE(10),TUPLE(8))
  32. C      IF(TUPLE(10).EQ.HENDC) GOTO 1
  33. C      IF(TUPLE(10).EQ.HENDD) GOTO 1000
  34. C *** DEBUG
  35.     WRITE(6,6700)TUPLE(10),TUPLE(10)
  36. 6700    FORMAT(1X,' TUPLE=',A4,' HEX=',I12)
  37.     IF(TUPLE(10).EQ.1128549957)GOTO 1
  38.     IF(TUPLE(10).EQ.1145327173)GOTO 1000
  39. C ***
  40.       CALL RMLOAD(1,TUPLE)
  41.       GO TO 50
  42.  1000 CONTINUE
  43.       CALL RMCLOS
  44.       STOP
  45.       END
  46.       SUBROUTINE GETL(LINE,NUMC)
  47.       DIMENSION LINE(20)
  48.       DIMENSION LINEX(20)
  49.       INTEGER BLANK
  50.     INTEGER*4 HENDC,HENDD
  51.     CHARACTER*4 CHENDC,CHENDD
  52.     EQUIVALENCE(HENDC,CHENDC),(HENDD,CHENDD)
  53.     CHARACTER*2 BLANKX
  54.     EQUIVALENCE(BLANK,BLANKX)
  55.       DATA BLANKX /' '/
  56.     DATA CHENDC/'ENDC'/,CHENDD/'ENDD'/
  57.       READ (2,10)LINEX
  58.    10 FORMAT(20A4)
  59.       LINE(1) = BLANK
  60.       LINE(20) = BLANK
  61.       M1 = NSCAN(LINEX,80,-80,CHAR(32),1,1)
  62.       IF(M1.LE.0) M1 = 2
  63.       ISHIFT = 2
  64.       IF(M1.EQ.1) ISHIFT = 1
  65.       IF(LINEX(1).EQ.HENDD) ISHIFT = 1
  66.       IF(LINEX(1).EQ.HENDC) ISHIFT = 1
  67.       IF(M1.NE.1) M1 = M1 + 1
  68.       CALL STRMOV(LINEX,1,79,LINE,ISHIFT)
  69.       NUMC = M1
  70.       RETURN
  71.       END
  72.  
  73. 
  74.